perm filename STATUS[NEW,LSP] blob
sn#575434 filedate 1981-03-24 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00036 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 -*-MIDAS-*-
C00006 00003
C00008 00004
C00010 00005
C00011 00006
C00016 00007
C00023 00008
C00024 00009
C00028 00010
C00031 00011
C00035 00012
C00038 00013
C00040 00014
C00042 00015
C00043 00016
C00045 00017
C00047 00018
C00048 00019
C00049 00020
C00052 00021
C00054 00022
C00057 00023
C00061 00024
C00064 00025
C00067 00026
C00070 00027
C00072 00028
C00075 00029
C00077 00030
C00079 00031
C00082 00032
C00085 00033
C00087 00034
C00090 00035
C00093 00036
C00097 ENDMK
C⊗;
;;; -*-MIDAS-*-
;;; **************************************************************
;;; ***** MACLISP ****** HAIRY STATUS FUNCTIONS ******************
;;; **************************************************************
;;; ** (C) COPYRIGHT 1981 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;; ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;; **************************************************************
SUBTTL INTERPRETER FOR STATUS SERIES
STATER: MOVEI B,(AR2A)
MOVEI A,(F)
PUSHJ P,CONS
FAC [ILLEGAL REQUEST!]
SSTATUS:
SKIPA F,CQSSTATUS ;FEXPR
STATUS: MOVEI F,QSTATUS ;FEXPR
MOVEI AR2A,(A)
JUMPE A,STATER
HLRZ A,(A) ;FIRST ARG IS FUNCTION NAME
PUSHJ P,STLOOK ;LOOK IT UP IN ASCII TABLE
JRST STATER
CAIE F,QSTATUS ;STATUS OR SSTATUS?
ADDI R,STBSS-STBS
λ` "∩%α∩bNR
_h(&6⎇2∃α⊃bBI$$KZ≡⊗Q¬"ε
2*α⊗:R∃H4(&e~!α⊃c L4(L
N!α"a5EHhP&R2zα⊃1DhP&"J∀Iα⊃1D1$4(Lj>Z⊗jα⊃2N<rε∞,HIn"ε≤Yα~>∩αεJ≡~α∞"⊗≤Z&:≤hP&6>4*%α¬bBεIJ
H4(&lzZ⊗%¬"Q2N<rε∞,hP&*J≥!α~↑t
∞,4SZJ⊗R-∩9α"-∩∃α~∀z5α~<rε∞-∧J→αε∀:Mα>\
d4*≥"εQEPJ"JJRα¬1"
H$%n≤"Iαε∀:Mα2M~P4(LBJ2%¬⊃1QEβ⊃A@4PJBVNBα~bAe⊂$%n∃JR∃α∧z&:R-⊃αR=∧
J≡M∧"⊗N∞∀JBR>∃_4(&¬*N!α5BA2I;$%n≤zV:R-⊃α~>∩αεJ≡_h*NR
!Ih&U*6B∃∧ 2NR
!X$%\RV6A∧J→α:zα6>J*αεJ≡_h(&B-~!αAdλ4(&DbJiα
a"¬$HIn⊗2≤)α≡⊗"α:⊗b"αεJ≤hP&&2$⊃αQ1k "~bαH$%n<*Qαε∀9α∩⊗≤~J&B$zH4(LRJNQαq-E""H4(%∧RJNQ¬~RεQ0H%mAαα⊗:⊃∧z→αε∀:L4(Jα*JN"αNRε#_$%m
↓αFV⎇"⊗⊃α
∩≤4(Jα*JN"αNRε#@$%m∩↓αFV⎇"⊗⊃αdJNQα|1αJ⊗≥ 4(&¬*N")¬↓2⊗Z `$%m~↓α⊗Z bVεR,!αεJ8h*NR
!Mh&-B∞!α
a"A$HIn2⊗
2∃αε∀9α>9¬α∩04PJ"JJRα¬1"
H4(&≤zMαQbB~bAHH%n∞⎇*:Qα
∩≡L4PJ∞ε6bαQ2b~iP$%\r=α6⎇∩∃αRD
9α~⎇*Iαεdb>↑⊗ h(%αU∩NQα≥"εQHHIm↓",r2⊗N~α&QαM→αε9∧bNV
∩H4(&lzZN%¬"Q1A∪↓AA@HIn~>∩αε9αe~V
IbαεJJ r≡∃α4zH4(L
∩∩ ¬"Q15
B~bAHH%mα$B∃α2
~Qαε∀9αNB,→αR=∧∩∃αJ-*N⊗⊂hP&2∩∩αRQ2[!EAMβ↓11"%!&t%]~⊗∃α<B⊗R"-⊃α&Q=→αJ⊗ b2eα qα2N,∩H4(L~ε&∃¬"Q1DhP%α∞ J9αR"aL4(J↓α*J≥!αNR
!H4*≥"εQYPJB>A∧2bA2 H%m5b→α>→∧
J≡Mph(&B⎇↓α~bαb_$%]∩!α&~αε∩∩∀*NMα|1αRε∀b∃α⊗u"Jd4PJ2∩ ¬"Q2m# AMAαa1"→Mh%n≡-!αNR
"VMα≥*
Iα$JNBε$~!αRMα∀4*≥"εQZ P&"J∃Qα⊃1D1$4(LRJNQ¬~RεQ:BRQ$hP4*N$
Q]hLRNAα∩bB∩2 ⊃"Q$HImA↓¬~V
Im"fB∃∧2V:∞$J>84PJ*JN"↓"⊃$HImE↓∧bNV
∩jRfB*α~V:≥"&>8hP&*J≥!αNR≤~ $%[⊃↓αN,∩I6RMα∃α↑M"!α∞D
Iαε∀84(&U∩NQα≥"N∞ HImM↓∧bNV
∩jRfB*α↑&RBα∞"ε∩αεJ≤hP&*J≥!αNR≤:Zε0HImQ↓∧:⊗QαdJNAα4
2V∀hP&*J≥!αNR≥~Zε0HImU↓¬~⊗QαdJNAα4
2V∀hP&*J≥!αNR≥~R:&`H%mYααN⊗Q¬"=αQlzI6:L`4(&lzZ∃α%!1"⊃HH%m]αα≡⊗Q∧2&b:,iαZεe*∀4(LRJNQ∧2&aDhP4*N$
QahLj>Z∃∧ 1"AHh(&N-"j5↓E↓$4(LRJNQ¬~RεQ_h(04*≥"N≡Z ah&"∃∩iα¬bB⊃$4T~FNN$
RVMPJB>BRαA2F≥~RεR-_4(4U~RNN4
1h&∧zAαAdλ4(&U~AαQeα∩2:lX4*N%~NYEPJ6>Z,iα¬1D!$4(Mα>B)¬↓04(hRNRN≥":&1PJB>A¬↓2∧4PJBVNDQαA2tzR:> h(&*∃~QαN%~NYDhP4*N$b>>-PJBVNDQαA2∧r≡⊗PHIn2>|YαVAβ)α∞"
∩Mα&rαRε
d(4(&DbJiα
a"¬$HIn→α≤
fMα<B⊗R"-⊃αNR
"VMα⎇⊃αNN$
RVLhP&6>4)αRQbB¬$$KZN.&αα>9α≥*∞∞⊗≥→1α2,
Z&::αB>&u"⊗IαLqαH4PJ6>Z≤IαI1lbNR
λh(&∞ J∃α→e
NRε%*L4(Jα6>Z≤IαI1lbNNR∀λ4*N$b-EhL~ε69¬"Q2N$∩¬"IHh(%αU∩NQα∧zB)DhP&ε>∀R9αIe~R2-λh(&B⎇α)αA`h(4*≥"N∞!PJBVNBα~bAd04(&¬*N!α5BA2PhP&ε∩$IαQ1
BA$4PJ"JJRα¬1""H4(&U~AαQe~BεR|h4(%∧RJNQ¬~RN∞Cλ4(&¬*N")¬↓2B:<*P4(LB2Ji∧ 1"¬Hh(&6⎇2∃αR"a"¬$hP&2NBαRQ1k→T4(LRNAα"b~b∞|rL4(LRJNQ¬~RN∞C⊂4(4U~RN∞C h&B-~")ααb⊗Zε`h(&*≥↓αQ25B:YDhRNRN≤AIh&lzZ∃α"a"~bαH4(& "∩%α"aE"AHh(&"∃∩5α¬bBQ$4PJB>A∧2bA2 h(&B⎇↓α~bαb_4(Lb∩ α%!2mQ ↓MAAba"→&hh(&N,∩%αR"aH4(LRJNQ¬~RεQ4λ4(04*≥*
RRbαNRε%*Mα~,
RVJ-→α~⊗
"VJ∃∧r>~⊗
"VJ∃bαNNR
"VM1∧
JJεHh(4*≤r>~⊗
"VJ∃Ph(&B-~!αAd~:>PhRN~⊗
"VJ∃Ph(&"∃∩iα d2⊗εR-∩⊗L4PJ*V6∧)α¬2∃∩⊗R(hP&"2∃Qα¬1D $4(MαVN"RαA26,jED4PJ*JN"α:>RtzP4(hRNN~,
RVJ+P4(&¬*N!ααb∧4(LBJJi∧⊃2~⊗
"VJ⊗_h(&B-~")ααb6⊗6 λ4(&U*6B9∧ 2NN4*¬H4PJ"JJRα¬1"αH4(&E∩Jiα∩b~⊗ε%*J⊗LhP&BV≤B)αAd~>:LhRNN~, Eh&lzZ⊗5∧ 2~⊗
"VJ⊗_h*NN4*¬IhLRJNQ¬α>BεPh(4*≥~:>~,
RVJ+P4(&¬*N!ααb∧4(LBJJi∧⊃2~⊗
"VJ⊗_h(&B-~")ααa:∩⊗eλ4(&U∩NQα≥~~⊗¬λh(4*≥~NN2+P&B>ααA2∧hP&BV≤B)αAe~R2>|X4(%∧RJNQ∧2ε2N(h(&*∃~QαR∃*∀4(hRNNN≥→h&N\JB¬α2b∞FN≥"εRV_h*NN≥→h%αlzZ⊗%∧12FN$
RVLhP&*Vmα9αQe~NNNe(4(&¬*N!ααbI]@hP&∞εLqα→2
~RεR-_4(%¬~.&B
α→2mlbNR
a2t4PI↓α6⎇2N%α2a62N≥"
∧4U~NNN≠ h&6⎇2∃αQe~R
¬D1$4(Lj>Z⊗jαQ2Bt∩V_4PJN⊗R|iα2Bt04(&lzZ⊗%∧→2B:∃*_4(MαVN"RαA2JLrR⊗Jph(&6⎇2∃α bBA$4PJBVNDQαA2≤z:L4PJ6>Z,iα 1E↓$4(L
>
*rα→2N≥~NMDhP&*J≥!αB>∧
(4(hQnNR
"VMα
∩Jεe¬∩⊗RV∀rMα¬∧b&NQ∧z→α~⎇*Iα:,j
⊗J≠P4)mα↓r6&r↓
α>2α∩&6≠q↓r6
A↓
α|1α∩&m→y↓rlJ9αεDJMα2,r≡R!r↓r6εBαεb&~α2⊗:="!x4SZR"∃∧b&NQ∧JMα~∀*N"2Jα∞>:≤*⊃α>rα⊗ε∞Bα∞ε2baαε:"α6εe∧∩∃α∩-~RJV≥"&Z2Jα6>∩L2&⊗⊂hRNεJ∀
eh&≤*Riα∩`$$%]~RεJ"α↑&RBα:&0hP&6>4*%αR"a]]];9\$%\
BBJ⎇B&6ε$J>9α|1α6εDJ6V5∧
b&M∧b⊗:≡$@4(&U~AαQd2b∞>u_4(&U~AαQb*∞>:_h(&6⎇2⊗%α∩b&9DhP&*NααQ1⊗D~>:LhP&6>4*%α dJ9T4PJ*NA¬!1⊗b≤z:L4PJ6>Z,Iα 2LqD4(LRJNQ¬B∞>:_H%n∞|rMαVαα~&: aα:Vl∩⊗Iα$B⊗9α∀*RVJph(04*≥*
RR`JNRε%*M↓-bαNRε%*Mα∞E"Jε9bαNRε%*MαNLrRε`hP4(4U~NB2≥→h&6⎇2⊗%α~bJ⊃bph(&N\JB∃αλh(%αlzZ⊗%∧→2J⊃E84(&lzZ⊗5∧→2J∩|∩)`4U~B2N≠P&6>4)α¬2∀">
)@h(&N,∩%α¬e∩⊃b8hP&*J≥!α:>$r>P4Ph*N∞E"Jε9Ph(&N\JB¬α2bnN.Mα¬αR"a"RQMh4*N≥J:RεCP4*::(%α6⎇2N%α2a""2∃QαRQbBRQ%Hh*:] Iα6>4)α→2\b∩ α%!2mE →MAA]"Q11¬jt4(MαVN!¬↓2∞~MAD4(M~⊗Ri∧
IE0HIn∞J|~,4(LRJNQ¬~NNfsλ4(
SUBTTL STATUS TTY, SSTATUS TTY
;;; (STATUS TTY <FILE>) RETURNS A LIST OF NUMBERS CONCERNING THE TTY:
;;; FOR ITS: (<TTYST1> <TTYST2> <TTYSTS>)
;;; FOR D10: (<GETLCH WORD> <FILE STATUS>)
;;; FOR SAIL: ( <GETLIN WORD>
;;; <FILE STATUS>
;;; <SETACT 1> <SETACT 2> <SETACT 3> <SETACT 4> )
;;; FOR D20: ( <CCOC 1> <CCOC 2>
;;; <JFN MODE WORD>
;;; <DEFERRED INTERRUPT CHARS MASK>
;;; <TERMINAL-CAPABILITIES-WORD> ;for VTS systems
;;; <TERMINAL-MODE-WORD> )
;;; RETURNS NIL IF <FILE> IS OMITTED AND THE JOB DOES NOT POSSESS A
;;; CONTROLLING TTY.
STTY: JUMPN T,STTY1
;TEST TO SEE WHETHER WE POSSESS A CONTROLLING TTY
IFN ITS,[
.SUSET [.RTTY,,TT] ;FOR ITS, SEE IF THIS JOB HAS THE TTY
JUMPL TT,FALSE .SEE %TBNOT
] ;END OF IFN ITS
IFN D10,[
IFN SAIL,[
GETLN D, ;RETURNS ZERO IF JOB IS DETACHED
JUMPN D,FALSE
] ;END OF IFN SAIL
IFE SAIL,[
GETLIN D, ;FOR D10, LH OF GETLIN WORD ZERO
TLNN D,-1 ; MEANS JOB IS DETACHED
JRST FALSE
] ;END OF IFE SAIL
] ;END OF IFN D10
IFN D20,[
LOCKI
GJINF ;FOURTH RETURNED VALUE IS -1 FOR
MOVE T,4
SETZB 1,2 ; A DETACHED JOB
SETZB 3,4
UNLOCKI
AOJE T,FALSE
] ;END OF IFN D20
SKIPA AR1,V%TYI
STTY1: POP P,AR1
PUSHJ P,TFILOK ;SAVES D (FOR SAIL), DOES A LOCKI, TTSAR IN TT
POP FXP,T ;POP THE LOCKI WORD
IFN ITS,[
.CALL TTYGET ;GET THREE VALUES IN D, R, F
.LOSE 1400
PUSH FXP,D ;TTYST1
PUSH FXP,R ;TTYST2
PUSH FXP,F ;TTYSTS
ZZZ==3
] ;END OF IFN ITS
IFN D10,[
PUSHJ P,D10TNM ;RETURNS APPROPRIATE TERMINAL NUMBER IN D
SA% GETLCH D
SA$ GETLIN D
PUSH FXP,D
SKIPL F.MODE(TT) .SEE FBT.CM
JRST STTY3
MOVSI R,(SIXBIT \TTY\) ;FOR THE REGULAR TTY,
SETZB D,F ; OPEN A TEMPORARY CHANNEL
OPEN TMPC,D ; SO CAN GET THE CHANNEL STATUS
HALT
GETSTS TMPC,D
RELEASE TMPC,
JRST STTY4
STTY3: MOVE R,F.CHAN(TT) ;FOR ANY OTHER TTY, USE THE EXISTING CHANNEL
LSH R,27
IOR R,[GETSTS 0,D]
XCT R
STTY4: PUSH FXP,D
IFE SAIL, ZZZ==2
IFN SAIL,[
PUSHN FXP,4
MOVSI D,-3(FXP)
SETACT D ;GET FOUR ACTIVATION WORDS
ZZZ==6
] ;END OF IFN SAIL
] ;END OF IFN D10
IFN D20,[
HRRZ 1,F.JFN(TT)
RFCOC ;READ CCOC WORDS
PUSH FXP,2 ;CCOC1
PUSH FXP,3 ;CCOC2
RFMOD ;READ JFN MODE WORD FOR TERMINAL
PUSH FXP,2
MOVE 1,[RT%DIM,,.FHSLF]
RTIW ;READ DEFERRED INTERRUPT WORD
PUSH FXP,3
PUSH FXP,R70
PUSH FXP,R70
SKIPE VTS20P
JRST STTY6
HRRZ 1,F.JFN(TT)
RTCHR
ERJMP STTY6
MOVEM 2,-1(FXP)
RTMOD
MOVEM 2,(FXP)
STTY6: SETZB B,C
ZZZ==6
] ;END OF IFN D20
PUSH FXP,T ;LOCKI WORD
UNLOCKI
PUSHJ P,CONS1PFX
REPEAT ZZZ-2, PUSHJ P,CONSPFX
JRST CONSPFX
EXPUNGE ZZZ
;;; (SSTATUS TTY <NUM1> <NUM2> ... <NUMN> <TTY>) SETS THE
;;; TTY STATUS WORDS FOR <TTY> (WHICH MAY BE OMITTED).
;;; ANY PARAMETERS WHICH ARE OMITTED OR NIL ARE NOT CHANGED.
SSTTY: HRRZ AR1,(P) ;LSUBR
CAIN AR1,TRUTH ;LAST ARG T => DEFAULT TTY
HRRZ AR1,V%TYI
JSP TT,XFILEP ;SEE IF LAST ARG IS A TTY
SKIPA AR1,V%TYI ;IF NOT, WE USE THE DEFAULT
AOSA D,T ;IN ANY CASE, PUT ADJUSTED NUMBER
SKIPA D,T ; OR ARGUMENTS IN D
POPI P,1 ; AND ADJUST THE STACK
SKIPN F,D ;NO ARGUMENTS MEANS CHANGE NOTHING
JRST TRUE
MOVE R,FXP ;SAVE CURRENT LEVEL OF FXP
SSTTY1: POP P,A ;FOR EACH ARGUMENT
SKIPE A ; WE PUSH TWO
JSP T,FXNV1 ; WORDS ONTO FXP:
PUSH FXP,TT ; THE FIRST IS THE NUMERIC VALUE, IF ANY,
PUSH FXP,A ; AND THE SECOND IS ZERO IF THE ARG WAS NIL
AOJL D,SSTTY1
;BECAUSE THE ARGUMENTS WERE POPPED OFF P IN REVERSE ORDER,
; THEY CAN NOW BE POPPED OFF FXP IN THE CORRECT ORDER.
;F HAS THE NEGATIVE OF THE NUMBER OF ARGUMENTS.
PUSH P,R ;NOW SAVE OLD FXP ON STACK
IT% PUSHJ P,TFILOK ;DOES A LOCKI, SAVES F
IT$ PUSHJ P,TIFLOK ;FOR ITS, WE ARE SETTING INPUT PARAMETERS
POP FXP,AR2A ;POP LOCKI WORD
IFN ITS,[
POP FXP,T
POP FXP,D
SKIPN T
SKIPA D,TI.ST1(TT) ;GET COPY OF THE OLD VALUE IF NOT SETTING NEW
MOVEM D,TI.ST1(TT) ;UPDATE TTYST1 WORD
AOJE F,SSTTY3 ;JUMP IF NO MORE ARGUMENTS
POP FXP,T
POP FXP,R
SKIPN T
SKIPA R,TI.ST2(TT)
MOVEM R,TI.ST2(TT) ;UPDATE TTYST2 WORD
AOJE F,SSTTY3 ;JUMP IF NO MORE ARGUMENTS
POP FXP,T
POP FXP,F
JUMPE T,SSTTY3 ;NULL THIRD ARG, THEN NEEDN'T DO HAIRIER CALL
.CALL TTYSAC ;THREE WORDS ARE IN D, R, F
.LOSE 1400
JRST SSTTY2
SSTTY3: .CALL TTY2ST ;SET JUST TTYST1, TTYST2
.LOSE 1400
] ;END OF IFN ITS
IFN D10,[
POP FXP,D
POP FXP,T
JUMPE D,SSTTY7
IFE SAIL,[
PUSHJ P,D10TNM
CAMN D,XC-1
GETLCH D
HRRI T,(D)
SETLCH T
] ;END OF IFE SAIL
IFN SAIL,[
SKIPL F.MODE(TT) .SEE FBT.CM
SETLIN T
] ;END OF IFN SAIL
SSTTY7: AOJE F,SSTTY2
POP FXP,D
POP FXP,T
JUMPE D,SSTTY4 ;FOR NULL ARG, FORGET THE FOLLOWING HAIR
SKIPL F.MODE(TT) .SEE FBT.CM
JRST SSTTY3
PUSH FXP,F
MOVSI R,(SIXBIT \TTY\)
SETZB D,F
OPEN TMPC,D ;OPEN A TEMP CHANNEL FOR THE TTY
HALT
SETSTS TMPC,T ;SET THE STATUS
RELEASE TMPC,
POP FXP,F
JRST SSTTY4
SSTTY3: MOVE R,F.CHAN(TT)
LSH R,27
IOR R,[SETSTS 0,T]
XCT R
SSTTY4:
IFN SAIL,[
AOJE F,SSTTY2 ;JUMP IF NO MORE ARGS
IRPC X,,[1234]
POP FXP,D
POP FXP,T
SKIPE D
MOVEM T,TI.ST!X(TT) ;UPDATE ACTIVATION WORD X
IFSN X,4, AOJE F,SSTTY5
TERMIN
SSTTY5: MOVEI T,TI.ST1(TT)
SETACT T
] ;END OF IFN SAIL
] ;END OF IFN D10
IFN D20,[
HRRZ 1,F.JFN(TT) ;GET JFN FOR SUBSEQUENT JSYS'S
POP FXP,T
POP FXP,D
SKIPE T
MOVEM D,TI.ST1(TT) ;UPDATE CCOC1
MOVE D,T
AOJE F,SSTTY3 ;JUMP IF NO MORE ARGUMENTS
POP FXP,T
POP FXP,R
SKIPE T
MOVEM R,TI.ST2(TT) ;UPDATE CCOC2
IOR D,T
SSTTY3: JUMPE D,SSTTY4 ;JUMP IF NO CHANGE TO CCOC'S
MOVE 2,TI.ST1(TT)
MOVE 3,TI.ST2(TT)
SFCOC ;SET CCOC'S
SSTTY4: AOJGE F,SSTTY2 ;JUMP IF NO MORE ARGUMENTS
POP FXP,D
POP FXP,2
JUMPE D,.+3
SFMOD ;UPDATE JFN MODE WORD
MOVEM D,TI.ST3(TT)
AOJE F,SSTTY2
POP FXP,D
POP FXP,3 ;DEFERRED TERMINAL INTERRUPT MASK
JUMPE D,.+5
MOVEM 3,TI.ST4(TT)
MOVE 1,[ST%DIM,,.FHSLF]
MOVE 2,[STDTIW] ;STANDARD TERMINAL INTERRUPT WORD
STIW ;SET TERMINAL INTERRUPT WORDS
AOJGE F,SSTTY2 ;JUMP IF NO MORE ARGUMENTS
POP FXP,D
POP FXP,2
;; ;; TERMINAL-CHARACTERISTICS-WORD -- CANT REALLY CHANGE IT
AOJGE F,SSTTY2 ;JUMP IF NO MORE ARGUMENTS
POP FXP,D
POP FXP,2
JUMPE D,SSTTY2
MOVEM 2,TI.ST6(TT)
STMOD ;UPDATE TERMINAL MODE WORD
] ;END OF IFN D20
SSTTY2: POP P,FXP ;RESTORE FXP
PUSH FXP,AR2A ;PUSH BACK LOCKI WORD
20$ SETZB B,C ;CLEAR JUNK OUT OF AC'S
JRST UNLKTRUE
IFN ITS,[
TTY2ST: SETZ
SIXBIT \TTYSET\ ;SET TTY VARIABLES
,,F.CHAN(TT) ;CHANNEL #
,,TI.ST1(TT) ;TTYST1
400000,,TI.ST2(TT) ;TTYST2
] ;END OF IFN ITS
SFRET: CAIN B,QBPS ;FIGURE OUT SPACE TYPE
JRST 1(R) ;BPS => SKIP 1
CAIN B,QRANDOM ;BAD SPACE TYPE => SKIP 0
JRST (R) ;LIST, FIXNUM, FLONUM, BIGNUM,
CAIN B,QARRAY ; SYMBOL, SAR => SKIP 2
MOVEI B,QRANDOM
CAIL B,QLIST
CAILE B,QRANDOM
JRST (R)
2DIF [HRREI TT,(B)]-NFF,QLIST
JRST 2(R)
SUBTTL STATUS UUOLI, SSTATUS UUOLI, STATUS IOC, STATUS CLI, SSTATUS CLI
SUUOLINKS:
IFE PAGING,[
SKIPN T,LDXSIZ
JRST FALSE ;RETURN NIL IF NO XCT HACKERY HAS BEEN DONE
SETZB TT,D ;ZERO COUNTER
TLNE T,400000
MOVEI D,TRUTH ;D GETS TRUE IF PURIFIED
MOVNS T ;MAKE UP AOBJN POINTER FOR XCT CALL AREA 2
HLL T,LDXBLT
MOVSS T
SUUOL1: SKIPN (T) ;COUNT FREE CELLS IN XCT CALL AREA
AOS TT
AOBJN T,SUUOL1
JSP T,FIX1A ;RETURN LIST OF PURE FLAG AND COUNT
PUSHJ P,NCONS
MOVE B,D
JRST XCONS
] ;END IFE PAGING
IFN PAGING,[
SKIPN LDXPNT ;IF NO XCT PAGES
JRST FALSE ; RETURN FALSE
MOVN TT,LDXLPC ;GET NUMBER OF FREE SLOTS IN LAST SEGMENT
JSP T,FIX1A
PUSHJ P,NCONS
MOVEI B,NIL
SKIPE LDXPFG ;PURIFIED?
MOVEI B,TRUTH
JRST XCONS
] ;END IFN PAGING
SSUUOLINKS:
MOVE A,USENDI
PUSHJ P,SSSENDI ;Re-init SENDI hook and friends
MOVE A,UUSRHNK
PUSHJ P,SSUSRHUNK
MOVE A,UCALLI
PUSHJ P,SSCALLI
IFE PAGING,[
SKIPN TT,LDXBLT ;ZAP CALLS FOR XCTS WITH A BLT
JRST FALSE
MOVEI T,(TT)
ADD T,LDXSM1
BLT TT,(T)
JRST TRUE
] ;END IFE PAGING
IFN PAGING,[
SKIPN T,LDXPNT ;LOOP OVER ALL XCT SEGMENTS
JRST FALSE
SSUUL1: JUMPE T,TRUE ;RETURN TRUE WHEN DONE
HRRZI TT,LDXOFS(T) ;TARGET ADR
HRL TT,LDXPSP(T) ;ADR-OFFSET TO GET DATA FROM
ADD TT,[LDXOFS,,0] ;MAKE INTO SOURCE ADR
BLT TT,SEGSIZ-1(T) ;RECOPY LINK AREA
HLRZ T,LDXPSP(T) ;LINK TO NEXT PAGE
JRST SSUUL1
] ;END IFN PAGING
IFN USELESS*ITS,[
SCLI: MOVEI T,%PICLI ;TEST TO SEE IF THIS BIT IS ON (IN IMASK)
TDNN T,IMASK ;IF ON, RETURN T, ELSE RETURN NIL
JRST FALSE
JRST TRUE
SSCLI: MOVEI T,%PICLI
MOVEI TT,IMASK
SKIPN A ;ON OR OFF?
TLOA TT,(ANDCAM T,) ;OFF, USE ANDCAM
HRLI TT,(IORM T,) ;ON, USE IORM
XCT TT ;MODIFY LISP'S MASK
SKIPN A
TLOA T,(TRZ)
TLO T,(TRO)
.CALL CLIVAR
.LOSE 1400 ;BAD NEWS....
JUMPN A,TRUE
POPJ P,
CLIVAR: SETZ
SIXBIT \USRVAR\
MOVEI %JSELF
MOVEI .RMASK
MOVEI
SETZ T
] ;END IFN USELESS*ITS
SNOINT: SKIPN A,UNREAL ;Check out UNREAL
JRST CPOPJ ; NIL
JUMPL A,TRUE ;-1 = T
POPJ P, ;Else QTTY, just return it
SUBTTL STATUS TIME, DATE, UNAME, USERID, JNAME, JNUMBER, SUBSYSTEM
IFN ITS,[
STIME: .RTIME TT,
JRST SDATE+1
SDATE: .RDATE TT,
AOJE TT,FALSE
MOVE D,TT
SUB D,[202020202021] ;21 ADJUSTS FOR THE AOJE
JSP F,STCVT
JSP F,STCVT
JSP F,STCVT
MOVNI T,3
JRST LIST
STCVT: SETZB TT,R
LSHC TT,6
IMULI TT,10.
ROTC D,6
ADD TT,R
JSP T,FXCONS
PUSH P,A
JRST (F)
SRCDIR: SKIPE A,SUDIR ;STATUS FOR "READ-CONNECTED-DIRECTORY"
POPJ P,
MOVE TT,IUSN
PUSHJ P,SIXATM
MOVEM A,SUDIR
POPJ P,
SUNAME: .SUSET [.RUNAME,,TT]
JRST SIXATM
SUSERID:
.SUSET [.RXUNAME,,TT]
JRST SIXATM
SJNAME: .SUSET [.RJNAME,,TT]
JRST SIXATM
SSUBSYSTEM:
.SUSET [.RXJNAME,,TT]
JRST SIXATM
SJNUMBER:
.SUSET [.RUIND,,TT]
JRST FIX1
SHOMEDIR:
.SUSET [.RHSNAME,,TT]
JRST SIXATM
SHSNAME: ;NEW HAIRY READ HSNAME
JUMPE T,SHOMEDIR ;NO ARGS, SAME AS (STATUS HOMEDIR)
PUSH FXP,T ;SAVE NUMBER OF ARGS OVER SUPERIOR CHECK
JSP T,SIDDTP ;IS THERE A DDT ABOVE US?
JRST SHSNA2 ;NOPE...
POP FXP,T
SETZ TT, ;ASSUME NULL ITS NAME
AOJE T,SHSNA1 ;ITS ARG GIVEN?
POP P,A ;YES, GET THE ITS NAME
PUSHJ P,SIXMAK ;GET SIXBIT INTO TT
SHSNA1: PUSH FXP,TT ;SAVE THE ITS NAME
POP P,A
PUSHJ P,SIXMAK ;CONVERT UNAME TO SIXBIT
PUSH FXP,TT ;STORE THAT ON FXP ALSO
MOVEI TT,-1(FXP) ;POINTER TO FIRST WORD
HRLI TT,..RHSNAME ;FOR .BREAK 12,
.BREAK 12,TT ;READ THE HSNAME FROM DDT
POP FXP,TT ;NOW CONVERT TO AN ATOM
PUSHJ P,SIXATM
POPI FXP,1 ;REMOVE EXTRA WORD FROM STACK
POPJ P, ;THEN RETURN
SHSNA2: POP FXP,T ;RESTORE NUMBER OF ARGS
MOVNS T
SUB P,R70(T) ;REMOVE THE APPROPRIATE NUMBER OF WORDS FROM P
SETZ A, ;RETURN NIL
POPJ P,
] ;END OF IFN ITS
IFE ITS,[
SHSNAME: ;HSNAME IS SIMPLY HOMEDIR
MOVNS T
SUB P,R70(T) ;REMOVE THE APPROPRIATE NUMBER OF WORDS FROM P
20$ JRST SRCDIR
20% MOVE A,SUDIR
20% POPJ P,
] ;END IFE ITS
IFN D10,[
IFE SAIL,[
SDATE: MOVE R,[%CNYER]
MOVE D,[%CNMON]
MOVE TT,[%CNDAY]
GETTAB R,
JRST FALSE
SUBI R,1900.
JRST STIM2
STIME: MOVE R,[%CNHOR]
MOVE D,[%CNMIN]
MOVE TT,[%CNSEC]
GETTAB R,
JRST FALSE
STIM2: GETTAB D,
JRST FALSE
GETTAB TT,
JRST FALSE
PUSHJ P,CONS1FX
MOVE TT,D
PUSHJ P,CONSFX
MOVE TT,R
JRST CONSFX
SSUBSYSTEM:
HRROI TT,.GTPRG ;GET PROGRAM NAME FOR MYSELF
GETTAB TT,
JRST FALSE
JRST SIXATM
] ;END OF IFE SAIL
IFN SAIL,[
SDATE: DATE D, ;DATE IN D = <<YEAR-1964.>*12.+MONTH-1>*31.+DAY-1
IDIVI D,31. ;REMAINDER IN R IS DAYS-1
AOJ R,
MOVE T,R
IDIVI D,12. ;REMAINDER HERE IS MONTH-1
AOJ R,
ADDI D,64. ;QUOTIENT IN D IS YEAR-1964.
PUSH FXP,D
PUSH FXP,R
PUSH FXP,T
JRST STIM2
STIME: TIMER TT, ;GET TIME IN TT
IDIVI TT,60. ;REDUCE TO SECONDS
IDIVI TT,60. ;NOW GET SECONDS AS A REMAINDER
MOVE R,D
IDIVI TT,60. ;REMAINDER IS MINUTES
PUSH FXP,TT
PUSH FXP,D ;REST IS HOURS
PUSH FXP,R
STIM2: PUSHJ P,CONS1PFX ;START A LIST WITH NUMBER ON FXP
PUSHJ P,CONSPFX ;ADD FIXNUM TO LIST
JRST CONSPFX ;ADD THIRD FIXNUM TO LIST
SSUBSYSTEM:
SETO TT,
GETNAM TT, ;GET (GENERIC?) NAME OF JOB
JRST SIXATM
] ;END OF IFN SAIL
SJNAME: MOVE TT,D10NAM
JRST SIXATM
SJNUMBER: PJOB TT, ;GET JOB NUMBER
JRST FIX1
SUSERID:
IFE SAIL,[
HRROI TT,.GTNM1 ;GET USER NAME FOR THIS JOB
GETTAB TT,
JRST SUNAME
HRROI D,.GTNM2
GETTAB D,
HALT ;HOW CAN THIS LOSE?
JUMPE TT,SUNAME
SETOM LPNF ;CONVERT TWO WORDS OF SIXBIT
MOVE C,PNBP ; TO ASCII IN PNBUF
SUSER1: LDB T,[360600,,TT]
ADDI T,40
IDPB T,C
LSHC TT,6
JUMPN TT,SUSER1
PUSHJ FXP,RDAEND
JRST RINTERN ;MAKE IT AN ATOMIC SYMBOL
] ;END OF IFE SAIL
SUNAME: GETPPN TT, ;PPNATM EXPECTS PPN IN TT
JFCL
JRST PPNATM
] ;END OF IFN D10
IFN D20,[
STIME: PUSHJ P,SDATIM ;RETURNS TIME IN F
MOVEI TT,(F)
IDIVI TT,60. ;REMAINDER IS SECONDS
MOVE R,D
IDIVI TT,60. ;THIS YIELDS HOURS AND MINUTES
EXCH TT,R
STIME1: PUSHJ P,CONS1FX ;CONS R, D, TT INTO A LIST OF FIXNUMS
MOVE TT,D
PUSHJ P,CONSFX
MOVE TT,R
JRST CONSFX
SDATE: PUSHJ P,SDATIM ;RETURNS DATE IN D AND R
HLRZ TT,R ;DAY-1
HLRZ R,D ;YEAR
SUBI R,1900. ;REDUCE IT TO A YEAR MOD 100.
MOVEI D,1(D) ;MONTH
AOJA TT,STIME1 ;INCREMENT DAY-1 TO DAY, AND GO CONS
SDATIM: LOCKI ;PREVENT JUNK IN AC'S FROM CAUSING TROUBLE
SETO 2, ;CURRENT TIME
SETZ 4,
ODCNV ;GET TIME AND DATE INFORMATION
MOVE D,2 ;RETURN INFORMATION IN D, R, F
MOVE R,3
MOVE F,4
SETZB 1,2 ;PREVENT TROUBLE AFTER UNLOCKI
SETZB 3,4
UNLKPOPJ
SJNAME: ;?
SSUBSYSTEM:
LOCKI
GETNM ;GET PROGRAM NAME
MOVE TT,1
SETZ 1,
UNLOCKI
JRST SIXATM
SRCDIR: JSP T,TNXUDI
JRST PNBFAT
SUSERID: ;?
SUNAME: LOCKI
MOVE TT,[PNBUF,,PNBUF+1]
SETZM PNBUF ;CLEAR PNBUF
BLT TT,PNBUF+LPNBUF-1
GJINF ;GET JOB INFORMATION
MOVE 2,1 ;1 HAS LOGIN DIRECTORY NUMBER
MOVE 1,PNBP
DIRST ;GET EQUIVALENT ASCII STRING
HALT ;BETTER NOT FAIL...
SETZB 1,2
UNLOCKI
JRST PNBFAT ;MAKE ASCII STRING AN ATOM
SJNUMBER:
LOCKI
GJINF ;GET JOB INFORMATION
MOVE TT,3 ;JOB NUMBER
SETZB 1,2
UNLOCKI
JRST FIX1
] ;END OF IFN D20
SUBTTL STATUS LINMODE
SSLINMODE:
CAMN T,XC-1
SKIPA AR1,V%TYI
POP P,AR1
POP P,A
PUSHJ P,TIFLOK ;DOES A LOCKI
MOVE T,F.MODE(TT)
SKIPN A
IFN ITS,[
ZZX==<%TG<ACT>>*010101010101 ;6 %TGACT BITS
SKIPA R,[STTYW1&ZZX] ;PUT APPROPRIATE ACTIVATION
SKIPA R,[STTYL1&ZZX] ; BITS IN R AND F
SKIPA F,[STTYW2&ZZX]
SKIPA F,[STTYL2&ZZX]
] ;END OF IFN ITS
IFN SAIL,[
SKIPA D,[[SACTW1 ? SACTW2 ? SACTW3 ? SACTW4],,]
SKIPA D,[[SACTL1 ? SACTL2 ? SACTL3 ? SACTL4],,]
] ;END OF IFN SAIL
IFN D20,[
SKIPA R,[XACTW]
SKIPA R,[XACTL]
] ;END OF IFN D20
TLZA T,FBT.LN
TLO T,FBT.LN
MOVEM T,F.MODE(TT)
IFN ITS,[
MOVE D,[ZZX]
ANDCAM D,TI.ST1(TT)
IORM R,TI.ST1(TT) ;CLOBBER IN ONLY ACTIVATION BITS
ANDCAM D,TI.ST2(TT)
IORM F,TI.ST2(TT)
EXPUNGE ZZX
] ;END OF IFN ITS
IFN SAIL,[
HRRI D,TI.ST1(TT)
BLT D,TI.ST4(TT) ;UPDATE STATUS WORDS
MOVEI T,TI.ST1(TT)
SETACT T ;TELL THE SYSTEM ABOUT IT
] ;END OF IFN SAIL
IFN D20,[
MOVEI D,770000 ;BITS 18.-23. ARE FOR WAKE-UP CONTROL
ANDCAM D,TI.ST3(TT)
IORM R,TI.ST3(TT)
] ;END OF IFN D20
UNLOCKI
JRST NOTNOT
SUBTTL STATUS DOW
IFN USELESS,[
IFN ITS,[
SDOW: .RYEAR TT,
AOJE TT,FALSE
LSH TT,-31
ANDI TT,16
MOVE T,SDOWQX(TT)
MOVEM T,PNBUF
MOVE T,SDOWQX+1(TT)
MOVEM T,PNBUF+1
JRST PNBFAT
SDOWQX:
IRP DAY,,[SUNDAY,MONDAY,TUESDAY,WEDNESDAY,THURSDAY,FRIDAY,SATURDAY]
ASCII \DAY\
TERMIN
] ;END OF IFN ITS
IFN D10,[
SDOW:
IFE SAIL,[
MOVE T,[%CNDTM] ;INTERNAL FORMAT DATE,,TIME
GETTAB T,
JRST FALSE
HLRZS T
] ;END OF IFE SAIL
IFN SAIL,[
DATE T, ;DATE IN T
DAYCNT T, ;CONVERT TO NUMBER OF DAYS
] ;END OF IFN SAIL
;T NOW HAS NUMBER OF DAYS SINCE 1-JAN-64 (A WEDNESDAY)
IDIVI T,7
LSH TT,1
MOVE T,SDOWQX(TT)
MOVEM T,PNBUF
MOVE T,SDOWQX+1(TT)
MOVEM T,PNBUF+1
JRST PNBFAT
SDOWQX: ;FUNNY ORDER FOR DEC-10
IRP DAY,,[WEDNESDAY,THURSDAY,FRIDAY,SATURDAY,SUNDAY,MONDAY,TUESDAY]
ASCII \DAY\
TERMIN
] ;END OF IFN D10
IFN D20,[
SDOW: PUSHJ P,SDATIM ;RH OF R GETS DAY OF WEEK (0 = MONDAY)
LSH R,1
MOVE T,SDOWQX(R)
MOVEM T,PNBUF
MOVE T,SDOWQX+1(R)
MOVEM T,PNBUF+1
JRST PNBFAT
SDOWQX: ;FUNNY ORDER FOR DEC-10
IRP DAY,,[MONDAY,TUESDAY,WEDNESDAY,THURSDAY,FRIDAY,SATURDAY,SUNDAY]
ASCII \DAY\
TERMIN
] ;END OF IFN D20
] ;END OF IFN USELESS
SUBTTL STATUS ABBREVIATE, STATUS MEMFREE
IFN USELESS,[
SABBREVIATE:
MOVEI TT,LRCT-2
HRRZ A,VREADTABLE
HRRZ TT,@TTSAR(A)
JRST FIX1
SSABBREVIATE:
SKIPN TT,A
JRST SSABB1
MOVEI TT,3
CAIE A,TRUTH
JSP T,FXNV1
SSABB1: MOVEI T,(TT)
MOVEI TT,LRCT-2
HRRZ B,VREADTABLE
HRRM T,@TTSAR(B)
JRST PDLNKJ
] ;END OF IFN USELESS
SMEMFREE:
PG$ MOVE TT,HINXM ;NUMBER OF WORDS IN HOLE
PG$ SUB TT,BPSH ;INTERRUPT HERE WOULD SCREW,
PG% MOVE TT,MAXNXM
PG% SUB TT,HIXM
JRST FIX1 ; WORRY, WORRY, WHO CARES
SUBTTL STATUS SYSTEM
SSYST0: WTA [SYMBOL REQUIRED - STATUS SYSTEM!]
SSYSTEM: ;(STATUS SYSTEM) ENTRY-POINT
JSP T,SPATOM
JRST SSYST0
JUMPE A,SSYST6
CAIN A,TRUTH
JRST SSYST6
MOVEI AR1,NIL
MOVEI B,QSYMBOL ;CHECK FOR SYMBOL HEADER IN SYSTEM SPACE
CAIE A,TRUTH
CAIN A,QUNBOUND
JRST SSYST2
CAIL A,QRDQTE ;First system symbol, except for T and QUNBOUND
CAILE A,SYMSYL
JRST SSYST7 ;NOT IN RANGE, CONTINUE CHECKING
SSYST2: EXCH A,AR1
PUSHJ P,XCONS
EXCH A,AR1
SSYST7: MOVEI B,QVALUE
HLRZ C,(A)
HRRZ C,(C)
CAIGE C,ESYSVC
JRST SSYST4
SSYST1: MOVEI B,SSSBRL
PUSHJ P,GETLA
JUMPE A,AR1RETJ
HLRZ B,(A)
HRRZ A,(A)
HLRZ C,(A)
CAIE B,QAUTOLOAD
JRST SSYST3
CAIL C,BSYSAP ;IS IT A SYSTEM AUTOLOAD PROP?
CAIL C,ESYSAP
JRST SSYST1 ;NOPE
JRST SSYST4 ;YUP
SSYST3: CAIE B,QARRAY
JRST SSYST5
CAIL C,BSYSAR ;IS IT A SYSTEM ARRAY
CAIL C,ESYSAR
JRST SSYST1
JRST SSYST4
SSYST5: CAIL C,ENDFUN ;SUBR OR VC ADDRESS IN SYSTEM AREA
JRST SSYST1
SSYST4: EXCH A,AR1 ;A WIN, SO CONS UP THIS PROPERTY NAME
PUSHJ P,XCONS
EXCH A,AR1
JRST SSYST1
SSYST6: MOVEI A,QVALUE
PUSHJ P,NCONS
MOVEI B,QSYMBOL
JRST XCONS
SUBTTL STATUS GCTIME, LISPVERSION, TTYREAD, ←, TERPRI, OPSYSTEM, SITE, FILESYSTEM
SSGCTIM:
JSP T,FXNV1
IT$ LSH TT,-2
10$ IDIVI TT,1000.
20$ IDIVI TT,1000.
EXCH TT,GCTIM
JRST SGCTM1
SGCTIM: MOVE TT,GCTIM
SGCTM1: PUSH P,CFIX1 ;FAKE OUT ENTRY INTO RUNTIME
JRST RNTM1
SLVRNO: MOVE A,[440600,,[LVRNO]]
JRST READ6C
SFILESYSTEM.TYPE: HLRZ A,FILEFT
POPJ P,
SOPSYSTEM.TYPE:
IT$ MOVEI A,QITS
10$ SA$ MOVEI A,QSAIL
10$ SA% HLRZ A,OPSYFT
20$ HLRZ A,OPSYFT
POPJ P,
SSITE: HLRZ A,SITEFT
POPJ P,
STTYREAD: SKIPA TT,[LRCT-2]
SLAP: HRROI TT,LRCT-1
SLAP1: HRRZ A,VREADTABLE
MOVE A,@TTSAR(A)
SKIPL TT
MOVSS A
JRST RHAPJ
SSTTYREAD: SKIPA R,[LRCT-2]
SSLAP: HRROI R,LRCT-1
SSLAP1: PUSHJ P,NOTNOT
HRRZ D,VREADTABLE ;INTERRUPT COULD SCREW HERE (FOO)
JSP T,.STOR0
POPJ P,
SLINMODE: MOVSI F,FBT<LN>
SKIPN T
SKIPA AR1,V%TYI
POP P,AR1
PUSHJ P,TIFLOK
TDNN F,F.MODE(TT)
TDZA A,A
MOVEI A,TRUTH
UNLKPOPJ
STERPRI:
SKIPN T
SKIPA AR1,V%TYO
POP P,AR1
IFN SFA,[
JSP TT,XFOSP
JRST .+3
JRST .+2
JRST FALSE
] ;END IFN SFA
PUSHJ P,TOFLOK
STERP1: SKIPLE FO.LNL(TT)
TDZA A,A
MOVEI A,TRUTH
UNLKPOPJ
SSTERPRI:
CAMN T,XC-1
SKIPA AR1,V%TYO
POP P,AR1
IFN SFA,[
JSP TT,XFOSP
JRST .+4
JRST .+3
POP P,A
JRST FALSE
] ;END IFN SFA
PUSHJ P,TOFLOK
POP P,A
MOVMS FO.LNL(TT)
SKIPE A
MOVNS FO.LNL(TT)
JRST STERP1
SUBTTL STATUS CRFILE, LOSEF
SCRFUN==FALSE ;***** TEMP CROCK *****
SCRFIL: SETZ A,
PUSHJ P,DEFAULTF
HRRZ A,(A)
POPJ P,
SLOSEF: MOVE T,LOSEF
JFFO T,.+1
MOVNS TT
ADDI TT,36.
JRST FIX1
SSLOS0: MOVEI A,(B)
WTA [BAD LOSEF - SSTATUS!]
SSLOSEF:
MOVEI B,(A)
SKIPE GCPSAR
JRST SLOSEF
JSP T,FXNV2
JUMPLE D,SSLOS0
CAILE D,16
JRST SSLOS0
MOVEI TT,1
LSH TT,(D)
SUBI TT,1
MOVEM TT,LOSEF
BPDLNKJ: MOVEI A,(B)
JRST PDLNKJ
SUBTTL STATUS JCL, HACTRN
IFE D10\D20\ITS SJCL: JRST FALSE
IFN D10\D20,[
SJCL: SKIPN T,SJCLBUF
JRST FALSE
PUSH FXP,T
PUSH FXP,[440700,,SJCLBUF+1]
SJCL2: ILDB TT,(FXP)
JUMPE TT,SJCL4
PUSHJ P,RDCH2
PUSH P,A
SOSLE -1(FXP)
JRST SJCL2
SJCL4: POPI FXP,1
POP FXP,T
SUB T,SJCLBUF
JRST LIST
] ;END OF IFN D10\D20
IFN ITS,[
SJCL: .SUSET [.ROPTION,,TT]
TLNN TT,%OPCMD
JRST FALSE ;EXIT WITH NIL IF NO COMMAND LINE
.SUSET [.RSUPPRO,,T]
JUMPL T,FALSE
SETZM JCLBF
MOVE T,[JCLBF,,JCLBF+1]
BLT T,JCLBF+LJCLBF-1
HLLOS JCLBF+LJCLBF-1
.BREAK 12,[..RJCL,,JCLBF]
MOVEI T,JCLBF ;MUST CLEAR BIT 35'S AS DDT MAY SET THEM!!
MOVEI TT,1 ;MASK
SJCL1A: ANDCAM TT,(T) ;TURN OFF BIT 35
CAIGE T,JCLBF+LJCLBF-1 ;DO ALL WORDS IN JCLBF
AOJA T,SJCL1A
PUSH FXP,R70
PUSH FXP,[440700,,JCLBF]
SJCL1: ILDB TT,(FXP)
JUMPE TT,SJCL3
SJCL2: PUSH P,TT
PUSHJ P,RDCH2
EXCH A,(P)
SOS -1(FXP)
CAIE A,↑M ;CAR-RET CAUSES TERMINATION
JRST SJCL1
SJCL4: MOVE T,-1(FXP)
SUB FXP,R70+2
JRST LIST
SJCL3: HRRZ T,(FXP)
CAIE T,JCLBF+LJCLBF-1
JRST SJCL4
MOVEI A,QSJCL
FAC [TOO MUCH JCL - STATUS!]
SDDTP: .SUSET [.RSUPPRO,,TT] ;STATUS HACTRN
JUMPL TT,FALSE ;NIL MEANS NO SUPERIOR
MOVEI A,TRUTH ;T MEANS THE UNKNOWN SUPERIOR
.SUSET [.ROPTION,,TT]
TLNE TT,OPTDDT
MOVEI A,QDDT
TLNE TT,OPTLSP
MOVEI A,QLISP
POPJ P,
] ;END OF IFN ITS
SUBTTL STATUS TTYSIZE, TTYTYPE, NEWIO OSPEED
IFN ITS\D20,[
STTYTYPE:
TDZA F,F
STTYSIZE:
MOVEI F,1
SKIPN T
SKIPA AR1,V%TYO
POP P,AR1
PUSHJ P,TOFLOK
IFN D20,[
JUMPN F,STTYS1
MOVE 1,F.JFN(TT)
GTTYP
MOVE TT,2
SETZB 2,3
] ;END OF IFN D20
IFN ITS,[
.CALL [ SETZ
SIXBIT \CNSGET\ ;GET CONSOLE PARAMETERS
,,F.CHAN(TT) ;CHANNEL #
2000,,D ;VERTICAL SCREEN SIZE
2000,,TT ;HORIZONTAL SCREEN SIZE
402000,,R ;TCTYP
]
JRST UNLKFALSE
JUMPN F,STTYS1
MOVE TT,R
] ;END OF IFN ITS
STTYS2: UNLOCKI
JRST FIX1
STTYS1:
20$ MOVE D,FO.LNL(TT) ;TERMINAL LENGTH
20$ MOVE TT,FO.RPL(TT) ;TERMINAL WIDTH
UNLOCKI
JSP T,FXCONS
MOVEI B,(A)
MOVE TT,D
JRST CONSFX
] ;END OF IFN ITS\D20
;OSPEED - RETURNS TTY OUPUT SPEED VARIABLE
SOSPEED:
SKIPN T
SKIPA AR1,V%TYO
POP P,AR1
PUSHJ P,TOFLOK
20$ JRST UNLKFALSE
IFN ITS,[
.CALL [ SETZ
SIXBIT \TTYVAR\
,,F.CHAN(TT)
,,[SIXBIT \OSPEED\]
402000,,TT
]
JRST UNLKFALSE
JRST STTYS2
] ;END OF IFN ITS
;TTYCOM, TTYOPT, TTYTYP NOT RETRIEVED
;; D10 version OF STTYTYPE and STTYSIZE
IFN D10,[
STTYTYPE:
IFE SAIL,[
SKIPE T
POPI P,1
JRST 0POPJ ;ALWAYS ZERO (?)
] ;END OF IFE SAIL
IFN SAIL,[
SKIPN T
SKIPA AR1,V%TYO
POP P,AR1
PUSHJ P,TOFLOK
PUSHJ P,D10TNM ;GET TTY NUMBER IN D
GETLIN D ;GET LINE CHARACTERISTICS
UNLOCKI
HLRZ T,D
TRZ T,150777 ;MASK OUT ALL NON-TTY-TYPE BITS
JFFO T,.+2
SETZ TT,
JRST FIX1
] ;END OF IFN SAIL
STTYSIZE:
SKIPN T
SKIPA AR1,V%TYO
POP P,AR1
PUSHJ P,TOFLOK
IFN SAIL,[
;R GETS SIZE, TT GETS WIDTH
MOVE F,[-2,,R] ;COUNT OF ARGS,,ADR OF ARGS
MOVE R,[15,,R] ;TERMINAL SIZE, -1 IF NOT DISPLAY
MOVE D,[6,,D] ;TERMINAL WIDTH (EXCEPT IF NON-ARPA TTY)
TTYSET F, ;DO TERMINAL OPERATIONS
SKIPGE R ;IF USE REAL PAGE LENGTH
MOVE R,FO.RPL(TT)
MOVE TT,D ;LINE LENGTH ENDS UP IN TT
] ;END OF IFN SAIL
MOVE R,FO.RPL(TT) ;GET REAL PAGE LENGTH
IFE SAIL,[
MOVE TT,FO.LNL(TT) ;GET LINEL
ADDI TT,1 ;WIDTH IS 1 MORE THAN LINEL
] ;END IFE SAIL
STTYS1: UNLOCKI
JSP T,FXCONS
MOVEI B,(A)
MOVE TT,R
JRST CONSFX
;;; GET DEC-10 TERMINAL NUMBER INTO D (-1 FOR OWN TERMINAL).
;;; ENTER WITH TTSAR OF FILE OBJECT IN TT.
D10TNM:
IFN SAIL,[
MOVE D,F.CHAN(TT)
SKIPL F.MODE(TT)
DEVNUM D, ;GET DEVICE NUMBER
SETO D, ;ON FAILURE, OR FOR TTY, USE -1
] ;END OF IFN SAIL
IFE SAIL,[
SETO D,
SKIPGE F.MODE(TT) .SEE FBT.CM
POPJ P,
HRRZ D,F.RDEV(TT) ;CONVERT SIXBIT UNIT NUMBER TO OCTAL
REPEAT 3,[
DPB D,[360600,,D]
DPB D,[030300,,D]
TLNN D,700000
LSH D,-3
LSH D,-3
] ;END OF REPEAT 3
ANDI D,777
] ;END OF IFE SAIL
POPJ P,
] ;END OF IFN D10
SUBTTL STATUS TTYSCAN, TTYCONS, TTYINT
STTYSCAN:
SKIPN T ;GET TTY PRE-SCAN FUNCTION
SKIPA AR1,V%TYI
POP P,AR1
IFN SFA,[
JSP TT,XFOSP
JRST STSCN1
JRST STSCN1
MOVEI A,(AR1)
MOVEI B,QTTYSCAN
MOVEI C,NIL ;special signal to read-out the "ttyscan"
JRST ISTCSH
STSCN1: ] ;END IFN SFA
PUSHJ P,TIFLOK
HRRZ A,TI.BFN(TT)
UNLKPOPJ
SSTTYSCAN:
CAMN T,XC-1 ;SET TTY PRE-SCAN FUNCTION
SKIPA AR1,V%TYI
POP P,AR1
IFN SFA,[
JSP TT,XFOSP ;DO WE HAVE AN SFA?
JRST SSTSC1 ;NOPE
JRST SSTSC1 ;DITTO
POP P,A ;GET THE ARG
JSP T,%NCONS ;TURN IT INTO A LIST
MOVEI C,(A) ;AS THE ARG TO THE SFA
MOVEI B,QTTYSCAN
MOVEI A,(AR1)
JRST ISTCSH
SSTSC1: ] ;END IFN SFA
PUSHJ P,TIFLOK
POP P,A
HRRZM A,TI.BFN(TT)
UNLKPOPJ
STTYCONS:
MOVEI AR1,(A) ;GET ASSOCIATED TTY FILE OF
CAIN AR1,TRUTH ; OPPOSITE DIRECTION, IF ANY
HRRZ AR1,V%TYI ;PREFER INPUT TTY
IFN SFA,[
JSP TT,XFOSP
JRST STCON1
JRST STCON1
MOVEI TT,SR.CNS ;IF SFA, THEN GET THE TTYCONS SLOT
HLRZ A,@TTSAR(AR1)
UNLKPOPJ
STCON1: ] ;END IFN SFA
PUSHJ P,TFILOK ;LEAVES ITS ARGUMENT IN AR1
HRRZ A,FT.CNS(TT) .SEE TTYMOR
UNLKPOPJ
SSTTYCONS:
SKIPE A ;CONS TOGETHER TWO TTY'S INTO
CAIN A,TRUTH ; A SINGLE CONSOLE
EXCH A,B ;PREFER TO SEE NIL OR T SECOND
CAIN A,TRUTH ;PREFER INPUT TTY FOR FIRST ARG
HRRZ A,V%TYI
SFA% MOVEI AR1,(A)
IFN SFA,[
JSP TT,AFOSP ;DO WE HAVE AN SFA?
JRST SSTCO1 ;NOPE
JRST SSTCO1 ;NOPE
MOVEI TT,SR.CNS ;IF SFA, THEN GET THE TTYCONS SLOT
HRLM B,@TTSAR(AR1)
UNLKPOPJ
JRST ISTCSH
SSTCO1: ] ;END IFN SFA
PUSHJ P,TFILOK
JUMPE B,SSTC1 ;SUNDER THEM IF ONE IS NIL
MOVEI T,TIFLOK
TLNN TT,TTS<IO>
MOVEI T,TOFLOK
UNLOCKI
CAIE B,TRUTH
JRST SSTC2
HRRZ B,V%TYI ;FOR SECOND ARG OF T, USE TTY
TLNN TT,TTS<IO> ; OF NECESSARY DIRECTION
HRRZ B,V%TYO
SSTC2: MOVEI AR1,(B)
PUSHJ P,(T)
HRRZ C,FT.CNS(TT)
HRRZM A,FT.CNS(TT) ;LINK THIS ONE TO THAT ONE
MOVEI TT,FT.CNS
SKIPE C ;IF IT WAS LINKED, UNLINK
SETZM @TTSAR(C) ; ITS FORMER PARTNER
EXCH B,@TTSAR(A) ;LINK THAT ONE TO THIS ONE
JUMPE B,UNLKTRUE ;????? THINK ABOUT ALL THIS?
CAIE B,(A) ;IF IT WAS LINKED, UNLINK
SETZM @TTSAR(B) ; ITS FORMER PARTNER
JRST UNLKTRUE
SSTC1: HRRZ B,FT.CNS(TT) ;GET ASSOCIATED TTY
SETZM FT.CNS(TT) ;UNLINK THAT FROM THIS
MOVEI TT,FT.CNS
SKIPE B ;ONLY UNCONS IF WAS PREVIOUSLY CONSED
SETZM @TTSAR(B) ;UNLINK THIS FROM THAT
JRST UNLKTRUE
STTYINT:
CAMN T,XC-1
SKIPA AR1,V%TYI
POP P,AR1
POP P,A
JSP T,CHNV1
MOVE F,TT
PUSHJ P,TIFLOK
ROT F,-1
ADDI TT,FB.BUF(F)
HRRZ A,(TT)
SKIPL F
HLRZ A,(TT)
UNLKPOPJ
SSTTYINT:
CAMN T,XC-2
SKIPA AR1,V%TYI
POP P,AR1
POP P,A
JSP T,PDLNMK
MOVEI B,(A)
POP P,A
JSP T,CHNV1
MOVE F,TT
PUSHJ P,TIFLOK
ROT F,-1
20$ PUSH P,TT ;SAVE TTSAR
ADDI TT,FB.BUF(F)
JUMPL F,SSTIN1
HRLM B,(TT)
20% JRST UNLKTRUE
20$ SKIPA
SSTIN1: HRRM B,(TT)
20% JRST UNLKTRUE
IFN D20,[
POP P,TT ;RESTORE TTSAR
ROT F,1 ;RESTORE CHARACTER
CAIE F,3 ;DON'T ALLOW USE TO ASSIGN ↑C
CAILE F,26. ;TOPS-20 ONLY SUPPORTS TO ↑Z
JRST UNLKTRUE ;RETURN TRUE, BUT DON'T DO TELL THE OP SYS
MOVE T,V%TYI ;ONLY DO FOLLOWING IF *THE* TTY
CAME TT,TTSAR(T) ;CHECK FOR TTSAR OF *THE* TTY
JRST UNLKTRUE
SETZB T,R ;SEARCH FOR A) FREE SLOT, B) EQUIVALENT SLOT
SSTIN2: CAMN F,CINTAB(T) ;EQUIVALENT SLOT?
JRST SSTIN3 ;YES, CODE ASSIGNED SO TAKE SPECIAL ACTION
SKIPN CINTAB(T) ;EMPTY SLOT?
MOVEI R,400000(T) ;YES, REMEMBER WE HAVE ONE
CAIGE T,CINTSZ-1 ;DONE ALL OF TABLE?
AOJA T,SSTIN2 ;NOPE, CONTINUE LOOPING
JUMPE B,UNLKTRUE ;IF TURNING OFF AND DIDN'T FIND IN TAB, DONE
SKIPN R ;FOUND A FREE SLOT?
JRST SSTIN4
MOVEM F,CINTAB-400000(R) ;YES, STORE NEW CHARACTER ASSIGNMENT
CAILE R,400005 ;CONVERT TO 400000+<D20 INTERRUPT CHANNEL>
ADDI R,22
HRLZI 1,(F) ;CHARACTER
HRRI 1,-400000(R) ;INTERRUPT CHANNEL
ATI ;ASSIGN THE CHARACTER TO THE CHANNEL
MOVEI A,TRUTH ;RETURN TRUE
UNLKPOPJ
SSTIN3: JUMPN B,UNLKTRUE ;RETURN IF CHARACTER WAS ALREADY ASSIGNED
SETZM CINTAB(T) ;CLEAR THE TABLE ENTRY
MOVEI 1,(F) ;DEASSIGN THE TERMINAL CODE
DTI
JRST UNLKTRUE ;THEN RETURN TRUE
SSTIN4: UNLOCKI
FAC [NO FREE INTERRUPT CHANNELS - (SSTATUS TTYINT)!]
] ;END IFN D20
SUBTTL STORAGE SPACE STATUS CALLS
SPDLMAX:
IFN PAGING,[
JSP D,SSGP1 ;0 - STATUS PDLMAX
SSPDLMAX: JSP D,SSGP1 ;1 - SSTATUS PDLMAX
] ;END OF IFN PAGING
.ELSE REPEAT 2, 0 ;0, 1 UNUSED
SGCSIZE: JSP D,SSGP1 ;2 - STATUS GCSIZE
SSGCSIZE: JSP D,SSGP1 ;3 - SSTATUS GCSIZE
SGCMAX: JSP D,SSGP1 ;4 - STATUS GCMAX
SSGCMAX: JSP D,SSGP1 ;5 - SSTATUS GCMAX
SGCMIN: JSP D,SSGP1 ;6 - STATUS GCMIN
SSGCMIN: JSP D,SSGP1 ;7 - SSTATUS GCMIN
SPDLSIZE: JSP D,SSGP1 ;10 - STATUS PDLSIZE
SPURSIZE: SKIPA B,A ;14 - STATUS PURSIZE
SSPCSIZE: JSP D,SSGP1 ;12 - STATUS SPCSIZE
MOVEI D,14 ;FAKE OUT A JSP D,SSGP1
CAIG B,QRANDOM ;LOSE IF BAD SPACE TYPE
CAIGE B,QLIST
JRST SSGPLZ
2DIF SKIPN (B),GTNPS8,QLIST
JRST SSGPLZ
JRST SSGP1A
SPDLROOM:
MOVEI D,20+SPDLMAX+1 ;20 - STATUS PDLROOM
SSGP1: SUBI D,SPDLMAX+1 ;GET CODE NUMBER IN D
MOVEI C,(B) ;YECH - SHUFFLE, SHUFFLE
MOVEI B,(A)
SSGP1A: MOVEI AR1,(B)
CAIN B,QRANDOM ;GET LINEARIZATION BY USING
JRST SSGPLZ ; QRANDOM FOR QARRAY
CAIN B,QARRAY
MOVEI B,QRANDOM
TRNE D,6 ;SKIP IF PDLMAX OR PDLSIZE
JRST SSGP1C
CAIL B,QREGPDL
CAILE B,QSPECPDL
JRST SSGPLZ
JRST SSGP1D
SSGP1C: CAIG B,QRANDOM ;LOSE IF BAD SPACE TYPE
CAIGE B,QLIST
JRST SSGPLZ
SSGP1D: ROT D,-1 ;LOW BIT=1 => SSTATUS
JUMPL D,SSG3A1
MOVE TT,@SSGPGT(D) ;ELSE GET VALUE TO RETURN
TRNE D,3
JRST SSGP2A
2DIF [SUB TT,(B)]C2,QREGPDL ;FOR PDL STUFF, CUT DOWN
TLZ TT,-1 ; QUANTITY BY PDL ORIGIN
SSGP2A: TLNN TT,-1 ;HACK SO THAT STATUS GCMIN
JRST FIX1 ; WILL RETURN A FLONUM
JRST FLOAT1 ; IF APPROPRIATE
SSGPGT:
10% 2DIF (B),XPDL,QREGPDL ;PDLMAX
10$ 0 ;UNUSED
2DIF (B),GFSSIZ,QLIST ;GCSIZE
2DIF (B),XFFS,QLIST ;GCMAX
2DIF (B),MFFS,QLIST ;GCMIN
2DIF (B),P,QREGPDL ;PDLSIZE
2DIF (B),SFSSIZ,QLIST ;SPCSIZE
2DIF (B),PFSSIZ,QLIST ;PURSIZE
0 ;UNUSED
2DIF (B),OC2,QREGPDL ;PDLROOM
SSGPLZ: MOVEI T,SBADSP ;BAD SPACE TYPE (OR MAYBE PDL TYPE?)
TRNN D,6
MOVEI T,[SIXBIT \BAD PDL TYPE - STATUS!\]
MOVEI A,(AR1)
%WTA (T)
MOVEI B,(A)
JRST SSGP1A
SSGP3$: JUMPE C,TRUE ;USED BY $ALLOC
;A CHANGE IN POLICY TO ALWAYS ALLOW A FLONUM
SSG3A1: MOVEI T,(D)
CAIN T,3 ;IF GCMIN,
JRST SSGP4 ; USE SPECIAL CHECKING CODE
SSGP3A: SKOTT C,FL ;ALLOW FLONUM
JRST SSGP3Z
MOVE TT,(C) ;GET THE FLONUM
PUSH FXP,D ;SAVE D OVER CALL TO IFIX
JSP T,IFIX ;CONVERT TO A FIXNUM
POP FXP,D
MOVE R,TT
JRST SSGP3Y ;THEN HANDLE AS IF FIXNUM
SSGP3Z: SKOTT C,FX ;MUST BE FIXNUM
JRST FALSE
MOVE R,(C) ;ELSE FETCH THE FIXNUM
SSGP3Y: TLNE R,-1 ;LOSE IF NEG OR TOO LARGE
JRST FALSE
JRST SSGPPT(D) ;ELSE JRST TO SPECIAL ROUTINE
SSGPPT:
10% JRST SSPM1 ;PDLMAX
10$ 0
JRST SSGS1 ;GCSIZE
JRST SSGX1 ;GCMAX
SSGM1: CAIL R,40 ;GCMIN
2DIF [CAMLE D,(B)]SSGMRV,QLIST ;FIXNUM GCMIN MUST HAVE
JRST FALSE ; "REASONABLE" VALUE
SSGM2:
2DIF [MOVEM R,(B)]MFFS,QLIST ;SO SAVE IT, ALREADY
JRST TRUE
SSGMRV: 20000 ;LIST
10000 ;FIXNUM
4000 ;FLONUM
BG$ 4000 ;BIGNUM
4000 ;SYMBOL
REPEAT HNKLOG+1, 100000 ;HUNKS
1000 ;SAR
SSGP4: MOVEI A,(C) ;(SSTATUS GCMIN ...) PERMITS
JSP T,FLTSKP ; A FLONUM ARGUMENT
JRST SSGP3A
JUMPLE TT,FALSE ;BUT MUST BE POSITIVE
CAML TT,[.005] ; AND BETWEEN .005 AND .95
CAMLE TT,[.95]
JRST FALSE
MOVE R,TT
JRST SSGM2
SSGS1: ANDI R,SEGMSK
2DIF [MOVEM R,(B)]GFSSIZ,QLIST ;SET GCSIZE
2DIF [CAMG R,(B)]XFFS,QLIST ;IF GREATER THAN GCMAX,
JRST TRUE ; MUST ALSO SET GCMAX TO MATCH
SSGX1:
2DIF [CAMGE R,(B)]SFSSIZ,QLIST ;GCMAX MAY NOT BE LESS
JRST FALSE ; THAN ACTUAL SIZE
XCTPRO
2DIF [HRRZM R,(B)]XFFS,QLIST
NOPRO
JRST TRUE
IFN ITS+D20,[
SSPM1: HRRZ T,P-QREGPDL(B) ;GET CURRENT PDL POINTER
ADD R,C2-QREGPDL(B) ;UP USER'S VALUE BY PDL ORIGIN
ANDI R,777760
TRNN R,PAGKSM
SUBI R,20
CAILE R,(T) ;NEW PDLMAX MUST BE ABOVE
CAML R,OC2-QREGPDL(B) ; CURRENT PDL POINTER, AND
JRST FALSE ; BELOW ABS OVERFLOW POINT
HRRZM R,XPDL-QREGPDL(B)
HRRZM R,ZPDL-QREGPDL(B) ;SO UPDATE CRAP
HRROS P-QREGPDL(B) ;SET LH OF PDL POINTER TO -1
JRST TRUE ; SO PDLOV WILL HACK IT PROPERLY
] ;END OF IFN ITS+D20
SUBTTL STATUS RANDOM
SRANDOM:
SETZ B,
MOVEI F,LRBLOCK-1+2 ;+2 FOR RNOWS AND RBACK
SRAND3: MOVE TT,RNOWS(F) ;CONS UP A LIST SUMMARIZING
PUSHJ P,CONSFX ; THE STATE OF THE RANDOM
SOJGE F,SRAND3 ; NUMBER GENERATOR
POPJ P,
SSRAN0: WTA [BAD ARGUMENT - STATUS RANDOM!]
SSRANDOM:
SKOTT A,LS
JRST SSRAN8
MOVEI B,(A)
JSP TT,SSRAN6
MOVEM R,RNOWS
JSP TT,SSRAN6
MOVEM R,RBACK
MOVNI F,LRBLOCK
SSRAN3: HLRZ C,(B)
JSP T,FXNV3
MOVEM R,RBLOCK+LRBLOCK(F)
HRRZ B,(B)
AOJL F,SSRAN3
JRST TRUE
SSRAN6: HLRZ C,(B)
JSP T,FXNV3
JUMPLE R,SSRAN0
CAILE R,LRBLOCK+1
JRST SSRAN0
HRRZ B,(B)
JRST (TT)
SSRAN8: JSP T,FXNV1
SKIPN TT ;0 IS BAD VALUE
MOVEI TT,1
JSP F,IRAND0
JRST TRUE
;;; Hooks for the EXTEND hackery
SSCALLI:
MOVE C,A
MOVEI B,QCALLI ;Look on the CALLI property for
PUSHJ P,$GET ;the "SUBR" to invoke
MOVE T,[ICALLI,,UCALLI]
MOVSI TT,(JRST) ;We JRST to it, and it hacks the stack
MOVEM C,(T) ;We write it, since don't have frob in A
JRST SSSEN1
SSSENDI: ;Set the SEND interpreter
MOVE T,[SENDI,,USENDI]
MOVSI TT,(JCALL 16,)
SSSENA: MOVEM A,(T) ;Remember what it is for (STATUS SENDI), GC
SSSEN1: MOVSS T ;Now hack the instruction cell
JUMPE A,SSSEN0 ;If NIL, zero SENDI so won't be XCT'd
HRR TT,A
MOVEM TT,(T) ;Save the call instruction for it
JRST TRUE ;Return truth
SSSEN0: SETZM (T)
JRST TRUE
SSUSRHNK: ;Set the USER-HUNK check
MOVE T,[USRHNK,,UUSRHNK]
MOVSI TT,(CALL 1,)
JRST SSSENA
IFN USELESS,[
IFN ITS,[
SUBTTL STATUS WHO-LINE [ETC.]
SSWHO1: SETZ F,
MOVE D,[441000,,F]
JSP T,FXNV1
IDPB TT,D
MOVEI A,(B)
JSP T,CHNV1X
IDPB TT,D
JSP T,FXNV3
IDPB R,D
MOVEI A,(AR1)
JSP T,CHNV1X
IDPB TT,D
.SUSET [.SWHO1,,F]
JRST TRUE
SSWHO2: PUSHJ P,SIXNUM
.SUSET [.SWHO2,,TT]
JRST TRUE
SSWHO3: PUSHJ P,SIXNUM
.SUSET [.SWHO3,,TT]
JRST TRUE
SWHO1: .SUSET [.RWHO1,,F]
MOVEI R,4
SETZ B,
MOVE D,[441000,,F]
SWHO1A: ILDB TT,D
JSP T,FXCONS
PUSHJ P,CONS
MOVEI B,(A)
SOJG R,SWHO1A
JRST NREVERSE
SWHO2: .SUSET [.RWHO2,,TT]
JRST FIX1
SWHO3: .SUSET [.RWHO3,,TT]
JRST FIX1
SIXNUM: SKOTT A,FX
JRST SIXMAK
POP P,T
JRST FXNV1
SMAR: MOVE T,IMASK
TRNN T,%PIMAR ;NIL IF LISP NOT USING MAR
JRST FALSE ; (BUT SUPERIOR MIGHT BE)
.SUSET [.RMARA,,D]
HLRZ TT,D
MOVEI A,(D)
PUSHJ P,ACONS
MOVEI B,(A)
JRST CONSFX ;RETURN LIST OF (MODE, LOCATION)
SSMAR: MOVEI F,%PIMAR
JSP T,FXNV1
TRZ TT,4
JUMPE TT,SSMAR5
IORM F,IMASK
.SUSET [.SIMASK,,F]
HRLI B,(TT)
.SUSET [.SMARA,,B]
JRST TRUE
SSMAR5: .SUSET [.SMARA,,R70]
ANDCAM F,IMASK
.SUSET [.SAMASK,,F]
JRST TRUE
;;; IFN USELESS
;;; IFN ITS
SSGCWHO: JSP T,FXNV1
ANDI TT,3
MOVEM TT,GCWHO
JRST TRUE
SITS: .CALL SITS9
.VALUE
PUSH FXP,T
JSP T,IFLOAT
FDVRI TT,(30.0)
JSP T,FLCONS
SETZ B,
PUSHJ P,CONSIT
POP FXP,TT
PUSHJ P,CONSFX
MOVE TT,D
PUSHJ P,CONSFX
MOVE TT,R
PUSHJ P,CONSFX
MOVE TT,F
JSP T,IFLOAT
SKIPL TT
FDVRI TT,(30.0)
JSP T,FLCONS
JRST CONS
SITS9: SETZ
SIXBIT \SSTATU\
2000,,F ;TIME UNTIL SYSTEM GOES DOWN
2000,,R ;SYSTEM BEING DEBUGGED
2000,,D ;NUMBER OF LOSERS
2000,,T ;NUMBER OF MEMORY ERRORS
402000,,TT ;TIME SYSTEM HAS BEEN UP
] ;END OF IFN ITS
] ;END OF IFN USELESS
SUBTTL ASCII TABLE OF STATUS FUNCTIONS
;;; ***** ASCII TABLE OF STATUS FUNCTIONS ***** PART 1 *****
STBA: ASCII \MACRO\ ;MACRO
ASCII \DIVOV\ ;DIVOV (DIVIDE OVERFLOW)
ASCII \VECTO\ ;VECTOR
ASCII \TTY\ ;TTY
ASCII \TOPLE\ ;TOPLEVEL
ASCII \BREAK\ ;BREAKLEVEL
ASCII \UREAD\ ;UREAD
ASCII \UWRIT\ ;UWRITE
ASCII \+\ ;+ (SUPRA-DECIMAL DIGITS OPTION)
ASCII \GCMIN\ ;GCMIN
ASCII \SYNTA\ ;SYNTAX
ASCII \CHTRA\ ;CHTRAN (CHARACTER TRANSLATION)
ASCII \TTYIN\ ;TTYINT
ASCII \GCTIM\ ;GCTIME
ASCII \LOSEF\ ;LOSEF (LAP OBJECT STORAGE EFFICIENCY FACTOR)
ASCII \TERPR\ ;TERPRI (SUPPRESSION OF AUTO-TERPRI)
ASCII \←\ ;← (CAN PRIN1 USE ← FIXNUM SYNTAX)
ASCII \TTYRE\ ;TTYREAD
ASCII \FEATU\ ;FEATURE
ASCII \NOFEA\ ;NOFEATURE
IFN USELESS, ASCII \ABBRE\ ;ABBREVIATE
ASCII \UUOLI\ ;UUOLINKS
ASCII \GCMAX\ ;GCMAX
IFN PAGING, ASCII \PDLMA\ ;PDLMAX
ASCII \GCSIZ\ ;GCSIZE
ASCII \LINMO\ ;LINMODE
ASCII \CRFIL\ ;CRFILE (CURRENT FILE)
ASCII \CRUNI\ ;CRUNIT (CURRENT UNIT)
ASCII \EVALH\ ;EVALHOOK (FOR MULTICS COMPATIBILITY)
ASCII \TTYSC\ ;TTYSCAN
ASCII \TTYCO\ ;TTYCONS
ASCII \RANDO\ ;RANDOM
IFN USELESS,[
IFN ITS,[
ASCII \WHO1\ ;WHO1 ;ITS WHO-LINE
ASCII \WHO2\ ;WHO2 ; DISPLAY
ASCII \WHO3\ ;WHO3 ; VARIABLES
ASCII \MAR\ ;MAR ;MAR BREAK FEATURE
ASCII \GCWHO\
] ;END OF IFN ITS
] ;END OF IFN USELESS
ASCII \PUNT\ ;PUNT ;TRUE MEANS NO FUNCTIONAL VARIABLES
ASCII \FLUSH\ ;FLUSH ;NON-NIL MEANS FLUSH PAGES UPON
; A SUSPEND
IFN USELESS*ITS, ASCII \CLI\ ;CLI ;DISABLE/ENABLE CLI INTERRUPTS
ASCII \NOINT\ ;NOINT ;Enable/disble interrupts
ASCII \SENDI\ ;SENDI ;SEND interpreter
ASCII \CALLI\ ;CALLI ;CALL interpreter
ASCII \USRHU\ ;USRHU ;USRHUNK routine
ASCII \SXHAS\ ;OLD STYLE SXHASHING
LSSTBA==.-STBA ;END OF ENTRIES WHICH CAN BE SSTATUS'D
;;; ***** ASCII TABLE OF STATUS FUNCTIONS ***** PART 2 *****
ASCII \FASLN\ ;FASLNAMELIST
ASCII \PURSI\ ;PURSIZE
ASCII \PDLSI\ ;PDLSIZE
ASCII \DAYTI\ ;DAYTIME
ASCII \DATE\ ;DATE
IFN USELESS, ASCII \DOW\ ;DOW (DAY OF WEEK)
ASCII \TTYSI\ ;TTYSIZE (HEIGHT . WIDTH)
ASCII \UNAME\ ;UNAME (USER NAME)
ASCII \USERI\ ;USERID
ASCII \XUNAM\ ;XUNAME
ASCII \JNAME\ ;JNAME (JOB NAME)
ASCII \SUBSY\ ;SUBSYSTEM
ASCII \JNUMB\ ;JNUMBER
ASCII \HOMED\ ;HOMEDIR (HOME DIRECTORY NAME)
ASCII \HSNAM\ ;HSNAME (SMART HOME DIRECTORY NAME)
ASCII \LISPV\ ;LISPVERSION
ASCII \JCL\ ;JCL (JOB COMMAND LINE)
IT$ ASCII \HACTR\ ;HACTRN
ASCII \UDIR\ ;UDIR (USER DIRECTORY NAME)
ASCII \FXPDL\ ;FXPDL (FIXNUM PDL)
ASCII \FLPDL\ ;FLPDL (FLONUM PDL)
ASCII \PDL\ ;PDL (REG PDL)
ASCII \SPDL\ ;SPDL (SPECIAL PDL)
ASCII \BPSL\ ;BPSL (BINARY PROGRAM SPACE LOW)
ASCII \BPSH\ ;BPSH (BINARY PROGRAM SPACE HIGH)
ASCII \SEGLO\ ;SEGLOG (LOG2 OF SEGMENT SIZE)
ASCII \SYSTE\ ;SYSTEM (SYSTEM ATOM)
ASCII \TABSI\ ;TABSIZE
ASCII \FILES\ ;FILESYSTEM-TYPE
ASCII \OPSYS\ ;OPSYSTEM-TYPE
ASCII \SITE\ ;SITE NAME
ASCII \SPCNA\ ;SPCNAMES (NAMES OF DATA SPACES)
ASCII \PURSP\ ;PURSPCNAMES
ASCII \PDLNA\ ;PDLNAMES
ASCII \SPCSI\ ;SPCSIZE
ASCII \PDLRO\ ;PDLROOM
ASCII \MEMFR\ ;MEMFREE
ASCII \NEWLI\ ;NEWLINE
ASCII \FILEM\ ;FILEMODE
ASCII \TTYTY\ ;TTYTYPE
ASCII \OSPEE\ ;OSPEED
ASCII \FASLO\ ;FASLOAD (RETURNS CURRENT LDBSAR)
IFN USELESS,[
IFN ITS,[
ASCII \ITS\ ;ITS
] ;END OF IFN ITS
] ;END OF IFN USELESS
ASCII \STATU\ ;STATUS
ASCII \SSTAT\ ;SSTATUS
ASCII \ARRAY\ ;ARRAY
LSTBA==.-STBA
SUBTTL STATUS DISPATCH TABLES
;;; FORMAT <4.9-4.7> , <4.6-3.8> , <2.9-1.1>
.FORMAT 37,002231104103
RADIX 4
;;; MAGIC TABLE OF STATUS OPERATIONS
;;; 4.9-4.7 OPERATION TYPE
;;; 0 SUBR-TYPE FUNCTION
;;; 1 LSUBR-TYPE FUNCTION
;;; 2 SUBR-TYPE WITH CHAR FIRST ARG
;;; 3 LSUBR-TYPE WITH CHAR FIRST ARG
;;; 4 GET LISP VALUE
;;; 5 SET LISP VALUE
;;; 6 SET TO T-OR-NIL
;;; 7 GET FIXNUM VALUE
;;; 4.6-4.5 ARGUMENT 1 TYPE
;;; 0 NO MORE ARGS
;;; 1 QUOTED ARGUMENT
;;; 2 TAKE REST AS QUOTED LIST
;;; 3 EVALUATED ARGUMENT
;;; 4.4-4.3 ARGUMENT 2 TYPE
;;; 4.2-4.1 ARGUMENT 3 TYPE
;;; 3.9-3.8 ARGUMENT 4 TYPE
;;; 3.7-3.1 ARGS INFO
;;; .FORMAT 37,002231104103
;;; RADIX 4
;;; ***** SSTATUS FUNCTION TABLE ***** MUST MATCH ASCII TABLE *****
STBSS: 3,1310,SSMACRO (FA23) ;MACRO
6,3000,RWG (FA1) ;DIVOV
5,3000,VCTRS (FA1) ;VECTOR
IT$ 1,3333,SSTTY (FA1234&1333) ;TTY
20$ 1,3333,SSTTY (FA1N&1333) ;TTY
10$ SA% 1,3333,SSTTY (FA12) ;TTY
10$ SA$ 1,3333,SSTTY (FA1N&1333) ;TTY
5,3000,TLF (FA1) ;TOPLEVEL
5,3000,BLF (FA1) ;BREAKLEVEL
0,2000,UREAD (FA0234);UREAD
0,2000,UWRITE (FA012) ;UWRITE
0,3000,SSPLSS (FA1) ;+
0,3300,SSGCMIN (FA2) ;GCMIN
2,1300,SSSYNTA (FA2) ;SYNTAX
2,1300,SSCHTRA (FA2) ;CHTRAN
1,3330,SSTTYINT (FA23) ;TTYINT
0,3000,SSGCTIM (FA1) ;GCTIME
0,3000,SSLOSEF (FA1) ;LOSEF
1,3300,SSTERPRI (FA12) ;TERPRI
0,3000,SSLAP (FA1) ;←
0,3000,SSTTYREAD (FA1) ;TTYREAD
0,1000,SSFEATURE (FA1) ;FEATURE
0,1000,SSNOFEATURE (FA1) ;NOFEATURE
IFN USELESS, 0,3000,SSABBREVIATE (FA1) ;ABBREVIATE
0,0000,SSUUOLINKS (FA0) ;UUOLINKS
0,3300,SSGCMAX (FA2) ;GCMAX
IFN PAGING, 0,3300,SSPDLMAX (FA2) ;PDLMAX
0,3300,SSGCSIZE (FA2) ;GCSIZE
1,3300,SSLINMODE (FA12) ;LINMODE
20% 0,2000,SSCRFIL (FA2) ;CRFILE
20$ 0,2000,SSCRFIL (FA23) ;CRFILE
0,2000,CRUNIT (FA012) ;CRUNIT
0,3000,FALSE (FA1) ;EVALHOOK
1,3300,SSTTYSCAN (FA12) ;TTYSCAN
0,3300,SSTTYCONS (FA2) ;TTYCONS
0,3000,SSRANDOM (FA1) ;RANDOM
IFN USELESS,[
IFN ITS,[
0,3333,SSWHO1 (FA4) ;WHO1
0,3000,SSWHO2 (FA1) ;WHO2
0,3000,SSWHO3 (FA1) ;WHO3
0,3300,SSMAR (FA2) ;MAR
0,3000,SSGCWHO (FA1) ;GCWHO
] ;END OF IFN ITS
] ;END OF IFN USELESS
6,3000,EVPUNT (FA1) ;PUNT
6,3000,SUSFLS (FA1) ;FLUSH
IFN USELESS*ITS, 0,3000,SSCLI (FA1) ;CLI
0,3000,NOINTERRUPT (FA1) ;NOINTERRUPT
0,3000,SSSENDI (FA1) ;SENDINTERPRETER
0,3000,SSCALLI (FA1) ;CALLINTERPRETER
0,3000,SSUSRHNK (FA1) ;USRHNK
6,3000,OLDSXHASHP (FA1) ;SXHASH
LSST==.-STBSS
IFN LSST-LSSTBA, WARN [WRONG LENGTH SSTATUS TABLE]
;;; .FORMAT 37,002231104103
;;; RADIX 4
;;; ***** STATUS FUNCTION TABLE ***** PART 1 (MATCHES STBSS) *****
STBS: 2,1000,SMACRO (FA1) ;MACRO
4,0000,RWG (FA0) ;DIVOV
4,0000,VCTRS (FA0) ;VECTOR
1,3000,STTY (FA01) ;TTY
4,0000,TLF (FA0) ;TOPLEVEL
4,0000,BLF (FA0) ;BREAKLEVEL
0,0000,SUREAD (FA0) ;UREAD
0,0000,SUWRITE (FA0) ;UWRITE
0,0000,SPLSS (FA0) ;+
0,3000,SGCMIN (FA1) ;GCMIN
2,1000,SSYNTAX (FA1) ;SYNTAX
2,1000,SCHTRAN (FA1) ;CHTRAN
1,3300,STTYINT (FA12) ;TTYINT
0,0000,SGCTIM (FA0) ;GCTIM
0,0000,SLOSEF (FA0) ;LOSEF
1,3000,STERPRI (FA01) ;TERPRI
0,0000,SLAP (FA0) ;←
0,0000,STTYREAD (FA0) ;TTYREAD
0,2000,SFEATURES (FA01) ;FEATURES
0,2000,SNOFEATURE (FA1) ;NOFEATURE
IFN USELESS, 0,0000,SABBREVIATE (FA0) ;ABBREVIATE
0,0000,SUUOLINKS (FA0) ;UUOLINKS
0,3000,SGCMAX (FA1) ;GCMAX
IFN PAGING, 0,3000,SPDLMAX (FA1) ;PDLMAX
0,3000,SGCSIZE (FA1) ;GCSIZE
1,3000,SLINMODE (FA01) ;LINMODE
0,0000,SCRFIL (FA0) ;CRFILE
0,0000,SCRUNIT (FA0) ;CRUNIT
0,0000,FALSE (FA0) ;EVALHOOK
1,3000,STTYSCAN (FA01) ;TTYSCAN
0,3000,STTYCONS (FA1) ;TTYCONS
0,0000,SRANDOM (FA0) ;RANDOM
IFN USELESS,[
IFN ITS,[
0,0000,SWHO1 (FA0) ;WHO1
0,0000,SWHO2 (FA0) ;WHO2
0,0000,SWHO3 (FA0) ;WHO3
0,0000,SMAR (FA0) ;MAR
7,0000,GCWHO (FA0) ;GCWHO
] ;END OF IFN ITS
] ;END OF IFN USELESS
4,0000,EVPUNT (FA0) ;PUNT
4,0000,SUSFLS (FA0) ;FLUSH
IFN USELESS*ITS, 0,3000,SCLI (FA0) ;CLI
0,0000,SNOINT (FA0) ;NOINTERRUPT
4,0000,USENDI (FA0) ;SENDINTERPRETER
4,0000,UCALLI (FA0) ;CALLINTERPRETER
4,0000,UUSRHNK (FA0) ;USRHNK
4,0000,OLDSXHASHP (FA0) ;SXHASH
IFN .-STBS-LSSTBA, WARN [WRONG LENGTH STATUS TABLE PART 1]
;;; .FORMAT 37,002231104103
;;; RADIX 4
;;; ***** STATUS FUNCTION TABLE ***** PART 2 (NON-SSTATUS ITEMS) *****
4,0000,LDFNAM (FA0) ;FASLNamelist
0,3000,SPURSIZE (FA1) ;PURSIZE
0,3000,SPDLSIZE (FA1) ;PDLSIZE
0,0000,STIME (FA0) ;DAYTIME
0,0000,SDATE (FA0) ;DATE
IFN USELESS, 0,0000,SDOW (FA0) ;DOW (DAY OF WEEK)
1,3000,STTYSIZE (FA01) ;TTYSIZE
0,0000,SUNAME (FA0) ;UNAME
0,0000,SUSERID (FA0) ;USERID
0,0000,SUSERID (FA0) ;XUNAME
0,0000,SJNAME (FA0) ;JNAME
0,0000,SSUBSYSTEM (FA0) ;SUBSYSTEM
0,0000,SJNUMBER (FA0) ;JNUMBER
IT$ 0,0000,SHOMED (FA0) ;HOMEDIR
IT% 20% 4,0000,SUDIR (FA0) ;HOMEDIR
20$ 0,0000,SRCDIR (FA0) ;
1,3300,SHSNAME (FA012) ;HSNAME
0,0000,SLVRNO (FA0) ;LISPVERSION
0,0000,SJCL (FA0) ;JCL
IT$ 0,0000,SDDTP (FA0) ;HACTRN
IFE D20\ITS 4,0000,SUDIR (FA0) ;UDIR
IFN D20\ITS 0,0000,SRCDIR (FA0) ;
7,0000,FXC2 (FA0) ;FXPDL
7,0000,FLC2 (FA0) ;FLPDL
7,0000,C2 (FA0) ;PDL
7,0000,SC2 (FA0) ;SPDL
7,0000,BPSL (FA0) ;BPSL (ORIGINAL BPS LOW)
7,0000,BPSH (FA0) ;BPS HIGH
7,0000,[SEGLOG] (FA0) ;SEGLOG
0,3000,SSYSTEM (FA1) ;SYSTEM
7,0000,IN10 (FA0) ;TABSIZE
0,0000,SFILES (FA0) ;FILESYSTEM-TYPE
0,0000,SOPSYS (FA0) ;OPSYSTEM-TYPE
0,0000,SSITE (FA0) ;SITE
4,0000,[SPCNAMES] (FA0) ;SPCNAMES
4,0000,[PURSPCNAMES] (FA0) ;PURSPCNAMES
4,0000,[PDLNAMES] (FA0) ;PDLNAMES
0,3000,SSPCSIZE (FA1) ;SPCSIZE
0,3000,SPDLROOM (FA1) ;PDLROOM
0,0000,SMEMFREE (FA0) ;MEMFREE
7,0000,IN0+↑M (FA0) ;NEWLINE
0,3000,SFILEMODE (FA1) ;FILEMODE
1,3000,STTYTYPE (FA01) ;TTYTYPE
IT$ 1,3000,SOSPEED (FA01) ;OSPEED
4,0000,LDBSAR (FA0) ;FASLOAD
IFN USELESS,[
IFN ITS,[
0,0000,SITS (FA0) ;ITS
] ;END OF IFN ITS
] ;END OF IFN USELESS
1,1000,SSSS (FA01) ;STATUS
1,1000,SSSSS (FA01) ;SSTATUS
0,0000,SARRAY (FA0) ;ARRAY
IFN .-STBS-LSTBA, WARN [WRONG LENGTH STATUS TABLE PART 2]
RADIX 8
.FORMAT 37,0 ;MAKE FORMAT 37 ILLEGAL AGAIN
ββ